Книги-online
Ch 17.htm
назад
|
содержание
|
вперед
Добавление компонента
к проекту
Для добавления компонента
к проекту в окне
Project Group
установите указатель на проекте ownControls
и щелкните правой кнопкой мыши, затем выберите команду Add (Добавить) и затем
значение
UserControl.
К нашему проекту будет добавлен еще один компонент.
Назовите его ownslider. Откройте окно редактора кода и введите там следующий
текст, описывающий необходимые свойства и переменные:
Dim rnlngValue As Long
Dim rnlngLimit As Long
Dim rnlngStep As Long
Public Property Get Value()
As Long
Value = rnlngValue
End Property
Public Property Let Value(ByVal
NewValue As Long)
If NewValue >= 0 Then
rnlngValue == NewValue Else rnlngValue = 0
PaintView
PropertyChanged "Value"
End Property
Public Property Get Limit()
As Long
Limit
=
rnlngLimit
End Property
Public Property Let Limit(ByVal
NewLimit As Long)
If NewLimit > 0 Then
rnlngLimit = NewLimit Else rnlngLimit = 1
PaintView
PropertyChanged "Limit"
End Property
Public Property Get Step()
As Long
Step = rnlngStep End Property
Public Property Let Step(ByVal
NewStep As Long)
If NewStep > 0 Then
rnlngStep = NewStep Else rnlngStep = 1
PaintView
PropertyChanged "Step"
End Property
Private Sub UserControl_ReadProperties(PropBag
As PropertyBag)
Limit
=
PropBag.ReadProperty("Limit",
1000000)
Value = PropBag.ReadProperty("Value",
500000)
Step = PropBag.ReadProperty("Step",
1000)
End Sub
Private Sub UserControl
WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty
"Limit", Limit, 1000000
PropBag.WriteProperty
"Value", Limit, 500000
PropBag.WriteProperty
"Step", Step, 1000
End Sub
Private Sub UserControl_InitProperties
()
Limit = 1000000
Value
=
500000
Step = 1000
End Sub
При изменении значения
каждого из этих свойств запускается процедура перерисовки объекта:
Private Sub PaintView()
'установить позицию карандаша
в верхний левый угол
CurrentX = 0
CurrentY = 0
'установить ширину линии
в зависимости от признака фокуса
If HaveFocus Then DrawWidth
= ScaleHeight / 50
Else DrawWidth = ScaleHeight
/ 500
'прорисовать белый прямоугольник
по всей площади компонента
Line (0, 0)-(Width - 10,
Height - 10), &H80000005, BF
'нарисовать синюю полоску
в зависимости от значения Value
Line (0, 0)-((Value /
Limit) * Width - 10, Height - 10), &H8000000D, BF
'отобразить значение Value
в текстовой форме поверх изображения желтым цветом с контрастной черной тенью
ForeColor = &HO&
CurrentX = 10
CurrentY = Height /2-90
Print Value
ForeColor = &HFFFF&
CurrentX = 0
CurrentY = Height / 2
- 100
Print Value
'нарисовать ограничивающую
рамку
Line (0, 0)-(Width - 10,
Height - 10), &НО, В
End Sub
При возникновении события
paint также следует вызывать перерисовку, так как это событие происходит всякий
раз, когда системе требуется отобразить объект:
Private Sub UserControl_Paint()
PaintView
End Sub
Для контроля за фокусом
предусмотрим переменную HaveFocus, значение которой будет устанавливаться при
возникновении событий GotFocus и LostFocus. Таким образом, когда наш объект
имеет фокус, значение переменной HaveFocus равно
True,
в противном случае
HaveFocus имеет значение
False.
Dim HaveFocus As Boolean
Private Sub UserControl_GotFocus()
HaveFocus = True
PaintView
End Sub
Private Sub UserControl_LostFocus()
HaveFocus = False
PaintView
End Sub
Чтобы обрабатывать нажатие
клавиш <<--> и
<-->>,
установим в окне
Properties
для свойства Keypreview компонента значение
True
и опишем реакцию на
событие KeyDown:
Private Sub UserControl
KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft
Value = Value - Step
Case vbKeyRight
Value
=
Value +
Step
End Select
End Sub
Как вы видите, нет необходимости
заниматься перерисовкой, поскольку она автоматически происходит при присвоении
нового значения свойству value.
назад
|
содержание
|
вперед
